perm filename CYCDRH[1,LMM] blob sn#034845 filedate 1973-04-12 generic text, type T, neo UTF8
  (SPECIAL @(STACK RA))
  (DE FINDNDS (RA RI)
      (PROG (X1)
       (COND (PATSELECT (SETQ RI T)))
     F (FOR NEW I := (1 NMX)
           DO (SETND I (QUOTE (0 . 0))))
       (COND ((SETQ X1 (ASSOC2 (CAAAR LINE) PATSELECT))
                 (SETND (CAR X1) (CONS (CADR X1) (CADDR X1))))
	     (T (SETND (CAAAR LINE) (QUOTE (15 . 15)))))
       (SETQ STACK (LIST 0 LINE))
       (COND ((FINDNDS1 RA RI T) (RETURN NIL)))
       (COND (PATSELECT (SETQ RI (SETQ PATSELECT NIL)) (SETQ RA 1))
	     ((LESSP 3 (SETQ RA (ADD1 RA))) (SETQ RI T)))
       (GO F)))

  (DE SETND (X Y)
      (PROG NIL (STORE (NODE X) (CAR Y))
                (STORE (NODE (PLUS X 20)) (CDR Y))
                (RETURN Y)))

  (DE FINDNDS1 (RA RI X3)
      (PROG (X1 X2 USED)
     C (COND ((ZEROP (NODE (SETQ X2 (CDAR (SETQ X1 (CAR LINE))))))
	      (COND (X3 (STKNDS X2 USED))))
	     ((RTLIN RI X1 USED) (PUSH3 USED LINE NIL)
			         (GO NXT)))
     A (COND ((ATOM (POP X3)) (GO D)))
       (SETND (CADR X3) (CAR X3))
       (COND ((RTLIN RI X1 USED) (PUSH USED) (PUSH LINE) (PUSH NIL))
	     (T (SETND (CADR X3) (QUOTE (0 . 0))) (GO A)))
    NXT(SETQ USED (CONS X1 USED))
       (SETQ X3 T)
       (COND ((SETQ LINE (CDR LINE)) (GO C))
	     (T (RETURN T)))
     D (POP LINE)
       (POP USED)
       (COND ((NULL STACK) (RETURN NIL))
	     (X3 (SETND X3 (QUOTE (0 . 0)))))
       (COND ((ATOM (CAR STACK)) (POP X3) (GO D)))
       (STORE (NODE (CADAR STACK)) 0)
       (SETQ X3 NIL)
       (GO C)))

(DE PUSH3 (USED UNUSED NODE)
    (SETQ STACK (CONS NODE
     (COND (USED (CONS (CONS (CAR USED) UNUSED) (CONS (CDR USED) STACK)))
           (T    (CONS (CONS NIL UNUSED) (CONS  NIL STACK))))))))

  (DE STKNDS (X L1)
      (PROG (Y X1 XMN XMX YMN YMX N1 N2)
            (PUSH3 L1 LINE X)
            (COND ((AND PATSELECT (SETQ X1 (ASSOC2 X PATSELECT)))
                   (PUSH (LIST (CONS (CADR X1) (CADDR X1)) X))
                   (RETURN T)))
          A (SETQ XMN 0)
            (SETQ XMX 100)
            (SETQ YMN 0)
            (SETQ YMX 100)
            (COND ((LESSP (LENGTH STACK) 6)
                   (PROG2 (SETQ XMN 16) (SETQ YMN 15))))
            (FOR X1 IN (CONN X)
             AS N1 IS (NODE X1)
              IF (NOT (ZEROP N1))
              AS N2 IS (NODE (PLUS X1 20))
              DO (SETQ XMN (MAX XMN (DIFFERENCE N1 RA)))
                 (SETQ XMX (MIN XMX (PLUS N1 RA)))
                 (SETQ YMN (MAX YMN (DIFFERENCE N2 RA)))
                 (SETQ YMX (MIN YMX (PLUS N2 RA))))
            (COND ((OR (GREATERP XMN XMX) (GREATERP YMN YMX))
                      (RETURN NIL)))
            (SETQ Y (FOR NEW I := (1 NMX)
                    LIST (CONS (NODE I) (NODE (PLUS I 20)))))
            (SETQ X1 NIL)
            (FOR N1 := (XMN XMX)
             FOR N2 := (YMN YMX)
             WHEN (NOT (MEMBER (CONS N1 N2) Y))
              DO (SETQ X1 T)
                 (PUSH (LIST (CONS N1 N2) X)))
            (COND ((NULL X1) (RETURN NIL)))
            (RETURN T)))